home *** CD-ROM | disk | FTP | other *** search
/ Power CD-ROM!! 8 / Power CD-ROM 8.iso / prgmming / pmd110 / bbgui.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-13  |  6KB  |  120 lines
  1. (* This file was mangled by Mangler 1.35 (c) Copyright 1993-1994 by Berend de Boer *)
  2. { Created : 1993-09-22
  3.  
  4. BBGui is a generic user interface which provides simple i/o services to low
  5. level programs. BBGui is adaptable to any gui as Windows or TurboVision. As
  6. is, it only provides a stdio/dos interface.
  7.  
  8.  
  9. Last changes :
  10. 93-12-08  Made Beep public. Beep removed from BBUtil
  11. 93-12-16  Added a portable Delay routine to BBGui
  12.           Added a portable Pause function which should give up a time slice
  13. 93-12-31  Added PrintWarning
  14. 94-03-17  Added BeepOff and BeepOn to turn beeping on and off
  15. 94-05-02  Added OpenProgressDlg and CloseProgressDlg to show a running
  16.           percentage (use SetProgressDlg)
  17. 94-05-16  Adapted to the Windows environment
  18. }
  19.  
  20.  
  21.  
  22.  
  23.  
  24. {$IFDEF MSDos}
  25. {$F+,O+,D-}
  26. {$ENDIF}
  27.  
  28. {S-,R-,Q-,I-}
  29. unit BBGui;
  30.  
  31. interface
  32.  
  33.  
  34. {* TurboVision constants *}
  35. const
  36.   cmYes = 12;
  37.   cmNo = 13;
  38.  
  39.  
  40. type
  41.   SpawnModes = (P_WAIT, P_NOWAIT, P_OVERLAY);
  42.  
  43. type
  44.   CloseProgressDlgType = procedure;
  45.   DelayType = procedure(MS : word);
  46.   FatalErrorType = procedure(const s : string; AHelpCtx : word);
  47.   InfoBoxType = procedure(const s : string; AHelpCtx : word);
  48.   OpenProgressDlgType = procedure(const ATitle : string; ATotal : longint);
  49.   PauseType = procedure;
  50.   PrintErrorType = procedure(const s : string; AHelpCtx : word);
  51.   PrintWarningType = procedure(const s : string; AHelpCtx : word);
  52.   SetProgressDlgType = procedure(Position : longint);
  53.   SpawnType = procedure(Mode : SpawnModes; const Path, CmdLine : string);
  54.   UserAnswerType = function(const s : string; AHelpCtx : word) : word;
  55.  
  56.  
  57. procedure Beep;
  58. procedure BeepOff;
  59. procedure BeepOn;
  60. procedure DefaultSpawn(Mode : SpawnModes; const Path, CmdLine : string);
  61. procedure DosDelay(MS : word);
  62. {$IFNDEF Windows}
  63. function GetTickCount : longint;
  64. {$ENDIF}
  65. procedure NoPause;
  66. procedure TextCloseProgressDlg;
  67. procedure TextFatalError(const s : string; AHelpCtx : word);
  68. procedure TextInfoBox(const s : string; AHelpCtx : word);
  69. procedure TextOpenProgressDlg(const ATitle : string; ATotal : longint);
  70. procedure TextPrintError(const s : string; AHelpCtx : word);
  71. procedure TextPrintWarning(const s : string; AHelpCtx : word);
  72. procedure TextSetProgressDlg(Position : longint);
  73. function  TextUserAnswer(const s : string; AHelpCtx : word) : word;
  74.  
  75.  
  76.  
  77. const
  78.   CloseProgressDlg : CloseProgressDlgType = TextCloseProgressDlg;
  79.   Delay : DelayType = DosDelay;
  80.   FatalError : FatalErrorType = TextFatalError;
  81.   InfoBox : InfoBoxType = TextInfoBox;
  82.   OpenProgressDlg : OpenProgressDlgType = TextOpenProgressDlg;
  83.   Pause : PauseType = NoPause;
  84.   PrintError : PrintErrorType = TextPrintError;
  85.   PrintWarning : PrintWarningType = TextPrintWarning;
  86.   SetProgressDlg : SetProgressDlgType = TextSetProgressDlg;
  87.   Spawn : SpawnType = DefaultSpawn;
  88.   UserAnswer : UserAnswerType = TextUserAnswer;
  89.  
  90.  
  91.  
  92.  IMPLEMENTATION USES {$IFDEF Windows}STRINGS , WINAPI , WINPROCS , {$ELSE}DOS , {$ENDIF}BBERROR , BBFILE , BBUTIL ;
  93. CONST O1l111O01III:BOOLEAN=TRUE;O1l1l1011OO1:STRING ='';OlI10I0lI1:LONGINT=0 ;O1010Ol0l00O1:LONGINT=0 ;
  94. {$IFDEF Windows}PROCEDURE BEEP ;BEGIN IF O1l111O01III THEN MESSAGEBEEP ($FFFF );END ;{$ELSE}PROCEDURE BEEP ;ASSEMBLER;
  95. ASM {} MOV AL , O1l111O01III{} CMP AL , 0 {} JE @@nobeep {} MOV DL , 07h {} MOV AH , 02h {} INT 21h {} @@nobeep : {} END;
  96. {$ENDIF}PROCEDURE BEEPOFF ;BEGIN O1l111O01III := FALSE ;END ;PROCEDURE BEEPON ;BEGIN O1l111O01III := TRUE ;END ;
  97. PROCEDURE DEFAULTSPAWN (MODE:SPAWNMODES;CONST PATH,CMDLINE:STRING );BEGIN {$IFDEF Windows}PRINTERROR
  98. ('Spawning of programs not supported under Windows.', 0 );{$ELSE}SWAPVECTORS ;EXEC (PATH , CMDLINE );SWAPVECTORS ;
  99. {$ENDIF}END ;PROCEDURE DOSDELAY (MS:WORD);VAR O1011l1l0llI0:LONGINT;O1010I1I0l1O0:LONGINT;BEGIN O1011l1l0llI0 :=
  100. GETTICKCOUNT ;O1010I1I0l1O0 := O1011l1l0llI0 + ROUND ((MS / (1000 / 18.2 )));REPEAT PAUSE ;UNTIL GETTICKCOUNT >=
  101. O1010I1I0l1O0 ;END ;{$IFNDEF Windows}FUNCTION GETTICKCOUNT :LONGINT ;BEGIN GETTICKCOUNT := MEML [ SEG0040 :$6C ] ;END ;
  102. {$ENDIF}PROCEDURE NOPAUSE ;BEGIN END ;PROCEDURE TEXTCLOSEPROGRESSDLG ;BEGIN O1l1l1011OO1 := '';END ;
  103. PROCEDURE TEXTFATALERROR (CONST S:STRING ;AHELPCTX:WORD);BEGIN PRINTERROR (S , AHELPCTX );HALT (1 );END ;
  104. PROCEDURE TEXTINFOBOX (CONST S:STRING ;AHELPCTX:WORD);{$IFDEF Windows}VAR OIOI1l01I01:ARRAY [ 0 .. 255 ]  OF CHAR;
  105. {$ENDIF}BEGIN {$IFDEF Windows}MESSAGEBOX (0 , STRPCOPY (OIOI1l01I01 , S ), 'Information', MB_OK + MB_ICONINFORMATION );
  106. {$ELSE}WRITELN (S );{$ENDIF}END ;PROCEDURE TEXTPRINTERROR (CONST S:STRING ;AHELPCTX:WORD);VAR O100llIl00IOl:WORD;
  107. {$IFDEF Windows}OIOI1l01I01:ARRAY [ 0 .. 255 ]  OF CHAR;{$ENDIF}BEGIN ASM {} MOV O100llIl00IOl, BP {} END;BEEP ;
  108. {$IFDEF Windows}MESSAGEBOX (0 , STRPCOPY (OIOI1l01I01 , S ), NIL , MB_OK );{$ELSE}WRITELN ('Error: ', S );
  109. {$ENDIF}LOGERROR ('Error: '+ S );IF @ DUMPSTACK <> NIL THEN DUMPSTACK (NIL , O100llIl00IOl );END ;
  110. PROCEDURE TEXTOPENPROGRESSDLG (CONST ATITLE:STRING ;ATOTAL:LONGINT);BEGIN WRITELN (ATITLE , ' 0%');O1l1l1011OO1 := ATITLE
  111. ;OlI10I0lI1 := ATOTAL ;O1010Ol0l00O1 := 0 ;END ;PROCEDURE TEXTSETPROGRESSDLG (POSITION:LONGINT);BEGIN IF O1l1l1011OO1 <>
  112. ''THEN BEGIN IF POSITION >= OlI10I0lI1 THEN WRITELN (CR , O1l1l1011OO1 , ' 100%')ELSE BEGIN IF (POSITION - O1010Ol0l00O1
  113. )>= 0.025 * OlI10I0lI1 THEN BEGIN WRITELN (CR , O1l1l1011OO1 , ' ', (POSITION * 100 )DIV OlI10I0lI1 , '%');O1010Ol0l00O1
  114. := POSITION ;END ;END ;END ;END ;PROCEDURE TEXTPRINTWARNING (CONST S:STRING ;AHELPCTX:WORD);
  115. {$IFDEF Windows}VAR OIOI1l01I01:ARRAY [ 0 .. 255 ]  OF CHAR;{$ENDIF}BEGIN BEEP ;{$IFDEF Windows}MESSAGEBOX (0 , STRPCOPY
  116. (OIOI1l01I01 , S ), NIL , MB_OK + MB_ICONEXCLAMATION );{$ELSE}WRITELN ('Warning: ', S );{$ENDIF}LOGERROR ('Warning: '+ S
  117. );END ;FUNCTION TEXTUSERANSWER (CONST S:STRING ;AHELPCTX:WORD):WORD ;VAR OOlIll10O1ll:STRING ;BEGIN WRITELN (S );REPEAT
  118. READLN (OOlIll10O1ll );UNTIL (OOlIll10O1ll <> '')AND (UPCASE (OOlIll10O1ll [ 1 ] )IN [ 'Y', 'N'] );IF UPSTR (OOlIll10O1ll
  119. [ 1 ] )='Y'THEN TEXTUSERANSWER := CMYES ELSE TEXTUSERANSWER := CMNO ;END ;END .
  120.